{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
module Magicloud.LDAP where

import Magicloud.List
import Data.List
import Data.Maybe

data Attribute = CN
               | OU
               | DC
               deriving (Read, Show, Eq)

type Value = String

type DN = [ (Attribute, Value) ]
instance Show DN where
  show = intercalate "," . map (\(a, v) -> concat [ show a, "=", v])
instance Read DN where
  readsPrec _ dn =
    let dn_ = map (\f ->
                    let av = splitByListB "=" f
                    in
                      if length av == 2 then
                        Just (read $ head av, last av)
                      else
                        Nothing
                  ) $ splitByListB "," dn
    in
      if any (== Nothing) dn_ then
        [([], dn)]
      else
        [(map fromJust dn_, "")]

data Filter = Equality Attribute Value
            | Presence Attribute
            | GreaterThan Attribute Value
            | LessThan Attribute Value
            | Proximity Attribute Value
            | Negation Filter
            | And [Filter]
            | Or [Filter]
instance Show Filter where
  show (Equality a v) = concat [ "(", show a, "=", escape v, ")" ]
  show (Presence a) = concat [ "(", show a, "=*)" ]
  show (GreaterThan a v) = concat [ "(", show a, ">=", escape v, ")" ]
  show (LessThan a v) = concat [ "(", show a, "<=", escape v, ")" ]
  show (Proximity a v) = concat [ "(", show a, "~=", escape v, ")" ]
  show (Negation f) = concat [ "(!", show f, ")" ]
  show (And fs) = concat [ "(&", concatMap show fs, ")" ]
  show (Or fs) = concat [ "(|", concatMap show fs, ")" ]

escape :: Value -> Value
escape v = concatMap (\c ->
                       case (lookup c [ ('(', "\\28") 
                                      , (')', "\\29")
                                      , ('&', "\\26")
                                      , ('|', "\\7c")
                                      , ('=', "\\3d")
                                      , ('>', "\\3e")
                                      , ('<', "\\3c")
                                      , ('~', "\\7e")
                                      , ('*', "\\2a")
                                      , ('/', "\\2f")
                                      , ('\\', "\\5c") ] ) of
                         Nothing -> [c]
                         Just c' -> c'
                     ) v
